home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Components / TEECHART / Delphi1_And_Delphi2 / EXAMPLES / OTHER / Html Table / TEEHTM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-24  |  10.5 KB  |  425 lines
  1. unit teeHTM;
  2.  
  3. interface
  4.  
  5. Uses Classes,SysUtils,Chart,Teengine;
  6.  
  7. { WARNING: This component is intended to run on 32-bit only
  8.    ( Delphi 2.0 or 3.0 )
  9. }
  10. type TImporterProc=Procedure(Var S:String) of object;
  11.  
  12. { This component extracts an HTML table from an HTM file and
  13.   fills a Series with points using the table cell values.
  14.  
  15.   Works with many different HTM Table configurations.
  16.   Manual adjust of properties is needed.
  17. }
  18.      TImporter=class(TComponent)
  19.      private
  20.        Row,Col:Integer;
  21.        tmpX:Double;
  22.        tmpLabel:String;
  23.  
  24.        FTitleRows:Integer;
  25.        FLabelColumn,
  26.        FXColumn,
  27.        FYColumn:Integer;
  28.        FCloneCount:Integer;
  29.        FInvertedDate,
  30.        FSwapDecimal,
  31.        FXDateTime,
  32.        FYDateTime:Boolean;
  33.        FChart:TCustomChart;
  34.        Procedure ProcTag(Const HTMTag:String; Var s:String; Proc:TImporterProc; i:Integer);
  35.      protected
  36.        Procedure CleanTags(Var s:String);
  37.        Procedure ProcessTags(Const HTMTag1,HTMTag2:String; Var s:String; Proc:TImporterProc);
  38.        Procedure ProcessTagOnce(Const HTMTag:String; Var s:String; Proc:TImporterProc);
  39.        Procedure ChartCaption(Var s:String);
  40.        Procedure NewTitleCol(Var s:String);
  41.        Procedure NewCol(Var s:String);
  42.        Procedure NewRow(Var s:String);
  43.        Procedure NewTable(Var s:String);
  44.      public
  45.        CloneCols:Array[1..10] of Integer;
  46.        Constructor Create(AOwner:TComponent); override;
  47.        Procedure ImportHTMTable(Const FileName:String);
  48.        Procedure AddCloneCols(Const Cols:Array of Integer);
  49.      published
  50.        property TitleRows:Integer read FTitleRows write FTitleRows default -1;
  51.        property XColumn:Integer read FXColumn write FXColumn default -1;
  52.        property YColumn:Integer read FYColumn write FYColumn default -1;
  53.        property LabelColumn:Integer read FLabelColumn write FLabelColumn default -1;
  54.        property XDateTime:Boolean read FXDateTime write FXDateTime default False;
  55.        property YDateTime:Boolean read FYDateTime write FYDateTime default False;
  56.        property InvertedDate:Boolean read FInvertedDate write FInvertedDate default False;
  57.        property SwapDecimal:Boolean read FSwapDecimal write FSwapDecimal default False;
  58.        property CloneCount:Integer read FCloneCount write FCloneCount default 0;
  59.        property Chart:TCustomChart read FChart write FChart;
  60.      end;
  61.  
  62. { Save a Series component to an HTML file, so the file will contain the
  63.   Series point values in HTML Table format.
  64. }
  65. Procedure SaveSeriesToHTM(Const FileName:String; ASeries:TChartSeries);
  66.  
  67. { Register TImporter in Delphi }
  68. Procedure Register;
  69.  
  70. implementation
  71.  
  72. Constructor TImporter.Create(AOwner:TComponent);
  73. begin
  74.   inherited Create(AOwner);
  75.   FTitleRows:=-1;
  76.   FCloneCount:=0;
  77.   FXColumn:=-1;
  78.   FYColumn:=-1;
  79.   FLabelColumn:=-1;
  80.   FXDateTime:=False;
  81.   FYDateTime:=False;
  82.   FInvertedDate:=False;
  83.   FSwapDecimal:=False;
  84.   tmpLabel:='';
  85. end;
  86.  
  87. Function IUpperCase(Var S: string): string;
  88. var t: Integer;
  89. begin
  90.   for t:=1 to length(s) do
  91.     if (s[t] >= 'a') and (s[t] <= 'z') then s[t]:=chr(ord(s[t])-32);
  92.   result:=s;
  93. end;
  94.  
  95. Procedure TImporter.AddCloneCols(Const Cols:Array of Integer);
  96. var t:Integer;
  97. begin
  98.   CloneCount:=High(Cols)-Low(Cols)+1;
  99.   for t:=Low(Cols) to High(Cols) do CloneCols[t-Low(Cols)]:=Cols[t];
  100. end;
  101.  
  102. Function IPos(Const a,b:String):Integer;
  103. var s:String;
  104. begin
  105.   s:=b;
  106.   result:=Pos(a,{$IFNDEF WIN32}IUppercase{$ENDIF}(s));
  107. end;
  108.  
  109. Procedure TImporter.ProcTag(Const HTMTag:String; Var s:String; Proc:TImporterProc; i:Integer);
  110. Var st:String;
  111. begin
  112.   Delete(s,1,i+Length(HTMTAG));
  113.   i:=Pos('>',s);
  114.   if i>0 then Delete(s,1,i);
  115.   i:=IPos('</'+HTMTag+'>',s);
  116.   if i>0 then
  117.   begin
  118.     st:=Copy(s,1,i-1);
  119.     Proc(st);
  120.     Delete(s,1,i+2+Length(HTMTAG));
  121.   end;
  122. end;
  123.  
  124. Procedure TImporter.ProcessTags(Const HTMTag1,HTMTag2:String; Var s:String; Proc:TImporterProc);
  125. var i1,i2,i:Integer;
  126.     HTMTag:String;
  127. begin
  128.   Repeat
  129.     i:=0;
  130.     i1:=IPos('<'+HTMTag1,s);
  131.     if HTMTag2<>'' then i2:=IPos('<'+HTMTag2,s)
  132.                    else i2:=0;
  133.     if i1>0 then
  134.     begin
  135.       if (i2<=0) or (i1<i2) then
  136.       begin
  137.         i:=i1;
  138.         HTMTag:=HTMTag1;
  139.       end;
  140.     end
  141.     else
  142.     if i2>0 then
  143.     begin
  144.       i:=i2;
  145.       HTMTag:=HTMTag2;
  146.     end;
  147.     if i>0 then ProcTag(HTMTAG,s,Proc,i);
  148.   Until i=0;
  149. end;
  150.  
  151. Procedure TImporter.ProcessTagOnce(Const HTMTag:String; Var s:String; Proc:TImporterProc);
  152. var i:Integer;
  153. begin
  154.   i:=IPos('<'+HTMTag,s);
  155.   if i>0 then ProcTag(HTMTAG,s,Proc,i);
  156. end;
  157.  
  158. Procedure TImporter.NewTitleCol(Var s:String);
  159. var t:Integer;
  160. begin
  161.   Inc(Col);
  162.   CleanTags(s);
  163.   if (Col=FXColumn) or (Col=FLabelColumn) then
  164.      FChart.BottomAxis.Title.Caption:=s
  165.   else
  166.   if FCloneCount=-1 then
  167.   begin
  168.     FChart.LeftAxis.Title.Caption:=s;
  169.     FChart[0].Title:=s;
  170.   end
  171.   else
  172.   begin
  173.     if Col=FYColumn then FChart[0].Title:=s
  174.     else
  175.     for t:=1 to FCloneCount do
  176.     if CloneCols[t]=Col then
  177.     begin
  178.       FChart[t].Title:=s;
  179.       break;
  180.     end;
  181.   end;
  182. end;
  183.  
  184. Procedure TImporter.CleanTags(Var s:String);
  185. var i1,i2:Integer;
  186.     tmpTag:String;
  187.     tmpChar:Char;
  188.     t:Integer;
  189. begin
  190.   Repeat
  191.     i1:=Pos('<',s);
  192.     if i1>0 then
  193.     begin
  194.       i2:=Pos('>',copy(s,i1+1,Length(s)));
  195.       if i2=0 then Delete(s,i1,1)
  196.       else
  197.       begin
  198.         tmpTag:=Copy(s,i1,i2+1);
  199.         if IUppercase(tmpTag)='<BR>' then s:=Copy(s,1,i1-1)+' '+Copy(s,i1+i2+1,Length(s))
  200.                                      else Delete(s,i1,i2+1);
  201.       end;
  202.     end;
  203.   Until i1=0;
  204.   Repeat
  205.     i1:=Pos('&#',s);
  206.     if i1>0 then
  207.     begin
  208.       i2:=Pos(';',copy(s,i1+2,Length(s)));
  209.       if i2>0 then
  210.       begin
  211.         tmpChar:=Chr(StrToInt(Copy(s,i1+2,i2-1)));
  212.         s:=Copy(s,1,i1-1)+tmpChar+Copy(s,i1+i2+2,Length(s));
  213.       end
  214.       else i1:=0;
  215.     end;
  216.   Until i1=0;
  217.   t:=1;
  218.   While t<=Length(s) do
  219.   if (s[t]=#13) or (s[t]=#10) then Delete(s,t,1)
  220.                               else inc(t);
  221. end;
  222.  
  223. Procedure TImporter.NewCol(Var s:String);
  224.  
  225.    Procedure InvertDate(Var s:String);
  226.    var i1,i2:Integer;
  227.    begin
  228.      i1:=Pos('/',s);
  229.      if i1>0 then
  230.      begin
  231.        i2:=Pos('/',copy(s,i1+1,Length(s)));
  232.        if i2>0 then
  233.        begin
  234.          i2:=i2+i1+1;
  235.          s:=copy(s,i2,length(s))+'/'+copy(s,i1+1,i2-i1-2)+'/'+copy(s,1,i1-1);
  236.        end;
  237.      end;
  238.    end;
  239.  
  240.    Procedure SwapDecimal(Var s:String);
  241.    var t:Integer;
  242.    begin
  243.      t:=1;
  244.      While t<=Length(s) do
  245.      begin
  246.        if s[t]='.' then
  247.        begin
  248.          s[t]:=',';
  249.          inc(t);
  250.        end
  251.        else
  252.        if s[t]=',' then Delete(s,t,1)
  253.                    else inc(t);
  254.      end;
  255.    end;
  256.  
  257.    { not: var tmp }
  258.    Function ConvertToValue(Var tmp:String; IsDateTime:Boolean):Double;
  259.    begin
  260.      if IsDatetime then
  261.      begin
  262.        if FInvertedDate then InvertDate(tmp);
  263.        result:=StrToDateTime(tmp);
  264.      end
  265.      else
  266.      begin
  267.        if FSwapDecimal then SwapDecimal(tmp);
  268.        try
  269.          result:=StrToFloat(tmp);
  270.        except
  271.          on EConvertError do result:=0;
  272.        end;
  273.      end;
  274.    end;
  275.  
  276. var tmpSeries:TChartSeries;
  277.     t:Integer;
  278. begin
  279.   Inc(Col);
  280.   if Col=FLabelColumn then
  281.   begin
  282.     CleanTags(s);
  283.     tmpLabel:=s;
  284.   end
  285.   else
  286.   if Col=FXColumn then
  287.   begin
  288.     CleanTags(s);
  289.     tmpX:=ConvertToValue(s,FXDateTime);
  290.   end
  291.   else
  292.   begin
  293.     if Col=FYColumn then tmpSeries:=FChart[0]
  294.     else
  295.     begin
  296.       tmpSeries:=nil;
  297.       for t:=1 to FCloneCount do
  298.       if CloneCols[t]=Col then
  299.       begin
  300.         tmpSeries:=FChart[t];
  301.         break;
  302.       end;
  303.     end;
  304.     if Assigned(tmpSeries) then
  305.     begin
  306.       CleanTags(s);
  307.       if tmpX=-1 then
  308.          tmpSeries.Add(ConvertToValue(s,FYDateTime),tmpLabel,clTeeColor)
  309.       else
  310.          tmpSeries.AddXY(tmpX,ConvertToValue(s,FYDateTime),tmpLabel,clTeeColor);
  311.     end;
  312.   end;
  313. end;
  314.  
  315. Procedure TImporter.NewRow(Var s:String);
  316. begin
  317.   Inc(Row);
  318.   Col:=-1;
  319.   tmpLabel:='';
  320.   tmpX:=-1;
  321.   if (FTitleRows<>-1) and (Row<=FTitleRows) then
  322.      ProcessTags('TD','TH',s,NewTitleCol)
  323.   else
  324.      ProcessTags('TD','TH',s,NewCol)
  325. end;
  326.  
  327. Procedure TImporter.ChartCaption(Var s:String);
  328. begin
  329.   CleanTags(s);
  330.   FChart.Title.Text.Add(s);
  331. end;
  332.  
  333. Procedure TImporter.NewTable(Var s:String);
  334. begin
  335.   Row:=-1;
  336.   ProcessTags('CAPTION','',s,ChartCaption);
  337.   ProcessTags('TR','',s,NewRow);
  338. end;
  339.  
  340. Procedure TImporter.ImportHTMTable(Const FileName:String);
  341. var tmp:TStringList;
  342.     t:Integer;
  343.     SeriesClass:TChartSeriesClass;
  344.     tmpSeries:TChartSeries;
  345.     s:String;
  346. begin
  347.   While FChart.SeriesCount>1 do FChart[1].Free;
  348.   for t:=1 to FCloneCount do
  349.   begin
  350.     SeriesClass:=TChartSeriesClass(FChart[0].ClassType);
  351.     tmpSeries:=SeriesClass.Create(FChart[0].Owner);
  352.     tmpSeries.Name:=TeeGetUniqueName(FChart[0].Owner,'Series');
  353.     tmpSeries.ParentChart:=FChart;
  354.   end;
  355.   tmp:=TStringList.Create;
  356.   try
  357.     FChart.BottomAxis.Title.Caption:='';
  358.     FChart.LeftAxis.Title.Caption:='';
  359.     tmp.LoadFromFile(FileName);
  360.     With FChart do
  361.     begin
  362.       Title.Text.Clear;
  363.       for t:=0 to SeriesCount-1 do
  364.       With Series[t] do
  365.       begin
  366.         Clear;
  367.         XValues.DateTime:=FXDateTime;
  368.         YValues.DateTime:=FYDateTime;
  369.       end;
  370.       Foot.Text.Clear;
  371.       Foot.Text.Add(FileName);
  372.     end;
  373.     {$IFDEF WIN32}
  374.     s:=Uppercase(tmp.Text);
  375.     {$ENDIF}
  376.     ProcessTagOnce('TITLE',s,ChartCaption);
  377.     ProcessTagOnce('TABLE',s,NewTable);
  378.   finally
  379.     tmp.Free;
  380.   end;
  381. end;
  382.  
  383. Procedure SaveSeriesToHTM(Const FileName:String; ASeries:TChartSeries);
  384. var t,tt:Integer;
  385. begin
  386.   With TStringList.Create do
  387.   try
  388.     Add('<html>');
  389.     Add('<body>');
  390.     Add('<table border=1>');
  391.     { title }
  392.     Add('<tr>');
  393.     Add('<td>'+ASeries.Title+'</td>');
  394.     { header }
  395.     for t:=0 to ASeries.ValuesLists.Count-1 do
  396.         Add('<td>'+ASeries.ValuesLists[t].Name+'</td>');
  397.     Add('</tr>');
  398.  
  399.     { rows... }
  400.     for t:=0 to ASeries.Count-1 do
  401.     begin
  402.       Add('<tr>');
  403.       Add('<td>'+ASeries.XLabel[t]+'</td>');
  404.       for tt:=0 to ASeries.ValuesLists.Count-1 do
  405.       With ASeries.ValuesLists[tt] do
  406.       if DateTime then Add('<td>'+DateTimeToStr(Value[t])+'</td>')
  407.                   else Add('<td>'+FloatToStr(Value[t])+'</td>');
  408.       Add('</tr>');
  409.     end;
  410.     Add('</table>');
  411.     Add('</body>');
  412.     Add('</html>');
  413.     SaveToFile(FileName);
  414.   finally
  415.     Free;
  416.   end;
  417. end;
  418.  
  419. Procedure Register;
  420. begin
  421.   RegisterComponents('TeeChart',[TImporter]);
  422. end;
  423.  
  424. end.
  425.